home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_2 / twview93.zip / MULTPATH.INC < prev    next >
Text File  |  1992-06-18  |  5KB  |  164 lines
  1. const
  2.   MaxMPS = 15;
  3.  
  4. type
  5.   DistanceTable = array [0..MaxMPS, 0..MaxMPS] of integer;
  6.   SectorVector  = record
  7.                     size : 0..MaxMPS;
  8.                     data : array [0..MaxMPS] of sectorindex;
  9.                   end;
  10.  
  11. procedure GetDistanceTableData( var D : distanceTable;
  12.                                 var V : SectorVector );
  13. { read n sectors, and specify the n^2 distances between pairs in D }
  14. var
  15.  i, j : 0..MaxMPS;
  16.  temp : sectorindex;
  17. begin
  18.   writeln('First sector specified is your home sector.');
  19.   writeln;
  20.   write('Please enter your sector values: ');
  21.   for i := 0 to V.size do
  22.     begin
  23.       temp := getsector;
  24.       if temp = 0 then
  25.         begin
  26.           v.size := 0;
  27.           exit;
  28.         end {if temp}
  29.       else
  30.         v.data[i] := temp;
  31.     end; {for i}
  32.   for i := 0 to V.size do
  33.     for j := 0 to V.size do
  34.       if i <> j then
  35.         D[ i, j ] := FixPath( V.data[i], V.data[j] );
  36.   for i := 0 to V.size do
  37.     D[i,i] := 0;
  38. end;
  39.  
  40. function RouteDist( closed : boolean;
  41.                          p : sectorvector;
  42.                          d : distancetable ) : integer;
  43. var
  44.   sum, i : integer;
  45. begin
  46.   if closed then
  47.     sum := d[ p.size, 0 ]
  48.   else
  49.     sum := 0;
  50.   for i := 1 to p.size do
  51.     sum := sum + d[ p.data[ i-1 ], p.data[i] ];
  52.   RouteDist := sum;
  53. end;
  54.  
  55. procedure HeapPermute(   closed : boolean;
  56.                               n : integer;
  57.                        var perm : SectorVector;
  58.                        var dists: distanceTable;
  59.                    var bestdist : integer;
  60.                    var bestrout : sectorvector );
  61. {B.R.Heap's permutation generator for contiguous lists}
  62. var
  63.   c, t, thisdist : integer;
  64. begin
  65.   c := 1;
  66.   if n > 2 then
  67.     HeapPermute( closed, n-1, perm, dists, bestdist, bestrout )
  68.   else
  69.     begin
  70.       ThisDist := RouteDist( closed, perm, dists );
  71.       if ThisDist < BestDist then
  72.         begin
  73.           BestDist := ThisDist;
  74.           BestRout := perm;
  75.         end;
  76.     end; {else}
  77.   while c < n do
  78.     begin
  79.       if odd(n) then
  80.         begin
  81.           t := perm.data[n];
  82.           perm.data[n] := perm.data[1];
  83.           perm.data[1] := t;
  84.         end
  85.       else
  86.         begin
  87.           t := perm.data[n];
  88.           perm.data[n] := perm.data[c];
  89.           perm.data[c] := t;
  90.         end;
  91.       c := c + 1;
  92.       if n > 2 then
  93.         HeapPermute( closed, n-1, perm, dists, bestdist, bestrout )
  94.       else
  95.         begin
  96.           ThisDist := RouteDist( closed, perm, dists );
  97.           if ThisDist < BestDist then
  98.             begin
  99.               BestDist := ThisDist;
  100.               BestRout := perm;
  101.             end;
  102.         end; {else}
  103.     end; {while}
  104. end;
  105.  
  106. procedure MultiPassSector;
  107. { accept a small number of sectors, and find the best path that hits these
  108. sectors (possibly returning to the base sector}
  109. var
  110.   s1, s2     : sector;
  111.   Table      : DistanceTable;
  112.   targets    : SectorVector;
  113.   routes     : SectorVector;
  114.   numsectors : integer;
  115.   i          : integer;
  116.   bestdist   : integer;
  117.   bestroute  : sectorVector;
  118.   closed     : boolean;
  119. begin
  120.   repeat
  121.     write('How many targets? (max ', maxMPS, ', enter 0 to abort)  ');
  122.     readln( NumSectors );
  123.   until (NumSectors >= 0) and (NumSectors <= MaxMPS );
  124.   if NumSectors = 0 then
  125.     exit
  126.   else
  127.     begin
  128.       targets.size := NumSectors;
  129.       GetDistanceTableData( Table, targets );
  130.       if targets.size = 0 then {they aborted routine}
  131.         exit;
  132.       BestDist := maxint;
  133.       Routes.size := NumSectors;
  134.       for i := 0 to NumSectors do routes.data[i] := i;
  135.       bestroute := routes;
  136.       closed := prompt('Closed path? ');
  137.       HeapPermute( closed, NumSectors, routes, table, bestdist, bestroute );
  138.     end;
  139.   writeln('Best distance is ', bestdist );
  140.   write('The best route is: ', targets.data[0] : 4);
  141.   for i := 1 to NumSectors do
  142.     write( ' > ', targets.data[ bestroute.data[i]] : 4 );
  143.   if closed then
  144.     write( ' > ', targets.data[0] : 4 );
  145.   writeln;
  146.   readln;
  147.   writeln('Here are the intermediate paths:');
  148.   for i := 1 to NumSectors do
  149.     begin
  150.       s1 := targets.data[ bestroute.data[i-1] ];
  151.       s2 := targets.data[ bestroute.data[i] ];
  152.       writeln( s1, ' to ', s2, ' of length ', fixpath( s1, s2 ) );
  153.       printpath( s1, s2 );
  154.       readln;
  155.     end; {for}
  156.   if closed then
  157.     begin
  158.       s1 := targets.data[ bestroute.data[ NumSectors] ];
  159.       s2 := targets.data[ 0 ];
  160.       writeln( s1, ' to ', s2, ' of length ', fixpath( s1, s2 ) );
  161.       printpath( s1, s2 );
  162.       readln;
  163.     end;
  164. end;